home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 3 / Cream of the Crop 3.iso / comm / aprs30_1.zip / MAPFIX.BAS < prev    next >
BASIC Source File  |  1993-12-02  |  30KB  |  669 lines
  1. REM MAPFIX.bas PROGRAM.  SEE EXPLAINATION BELOW
  2. REM
  3. MaxNumMAPS = 99' Current maximum number of maps loaded by APRS
  4. MaxNumPoints = 1000
  5. MaxNumLABELS = 99
  6. GOTO BEGIN
  7.  
  8. Info: COLOR 15, 1: CLS
  9.    PRINT " MAPFIX.bas VERSION 3.05 PROGRAM FOR FIXING APRS MAPS": PRINT
  10.    PRINT " MAPFIX 2.10 allowed you to add, move and delete points. Ver 3.01 allowed you"
  11.    PRINT " to add complete features!  And now 3.05 allows you to KILL complete features,"
  12.    PRINT " including deleting all points in a feature.  It also has a TRIM command for"
  13.    PRINT " removing all points and labels outside of a specified boundary.  This comand"
  14.    PRINT " is useful for removing points to begin a new smaller map."
  15.    PRINT " CAUTION, THIS PROGRAM IS NOT PERFECT... KEEP BACKUPS!  Do a little at a time!"
  16.    PRINT
  17.    PRINT " The original purpose of this program was to simply display new maps so you"
  18.    PRINT " could alternatively EDIT the map file and use MAPFIX to look at it and measure"
  19.    PRINT " locations and points.  Operating in the full QBasic environment, you could "
  20.    PRINT " keep both the MAPFIX program and the MAP file online simultanously and switch"
  21.    PRINT " back and forth.  Without QB, you must alternatively use EDIT and QBasic."
  22.    PRINT
  23.    PRINT " MAPFIX uses two cursors.  The normal yellow APRS cursor, and a White MapPoint"
  24.    PRINT " which will be the next point to be processed.  ALT Keys allow you to MOVE the"
  25.    PRINT " MapPoint to the cursor, ADD a new point at the cursor, or DELETE the MapPoint."
  26.    PRINT " MAPFIX.bas shows you decimal values of the cursor position, which are needed"
  27.    PRINT " if you want to use an editor for placing map labels in the MAP file."
  28.    PRINT
  29.    PRINT " ALSO NOTE THAT THE LIMITS IN APRS ARE 1000 POINTS, 99 FEATURES, and 99 LABELS!"
  30.    PRINT " If you need more points, features or labels, begin another map.";
  31.    LOCATE 25, 1: PRINT " HIT ANY KEY to continue...";
  32.    GOSUB GetChar: BEEP
  33.   
  34. Info2:   COLOR 15, 8: CLS
  35.    PRINT " PAGE 2 INSTRUCTIONS:  More about new features in version 3.05"
  36.    PRINT
  37.    PRINT " With this new MAPFIX.bas, you can not only modify features by moving, adding"
  38.    PRINT " or deleting POINTS, but you can now add and kill FEATURES too, ie: roads,"
  39.    PRINT " rivers, borders, etc, from within the program.  In addition to the new KILL"
  40.    PRINT " and TRIM commands, the G key will move the cursor (GOTO) to the MapPoint,"
  41.    PRINT " and the F key will FIND the MapPoint nearest the cursor location.  If the"
  42.    PRINT " MapPointer and FeatureName get out of sequence, the RESET command may fix"
  43.    PRINT " them, but you should save the file immediately and check it with an editor."
  44.    PRINT
  45.    PRINT " I find the capability to delete points very useful when making larger area"
  46.    PRINT " maps from several smaller detail maps.  First, I run MAPCNVRT.bas to convert"
  47.    PRINT " all of the smaller maps to new temporary files with the new origin of the new"
  48.    PRINT " larger map.  Then I use the KILL command in MAPFIX to eliminate all minor "
  49.    PRINT " roads, features and labels and then the DELETE POINT command to remove all"
  50.    PRINT " inconsequential minor points from the roads that will not be needed"
  51.    PRINT " at the larger scale.  Then I use the editor to combine all of the points and"
  52.    PRINT " labels into the new file."
  53.    PRINT
  54.    PRINT " A new MAPLIST command shows your MAPLIST.map file; and the OTHER MAPS command"
  55.    PRINT " shows all MAP borders so you can see how your new map fits in.  You may use F3"
  56.    PRINT " and F4 keys to select smaller or larger map borders to draw."
  57.    PRINT
  58.    Display$ = "UNKnown"
  59.  
  60.    RETURN
  61.  
  62. GetChar: a$ = "": DO UNTIL a$ <> "": a$ = INKEY$: LOOP: RETURN
  63.  
  64. BEGIN: GOSUB Info:
  65.    PRINT " HIT ANY KEY to proceed onto the HELP screen...";
  66.    GOSUB GetChar
  67.  
  68.    DIM x%(2 * MaxNumPoints), y%(2 * MaxNumPoints)
  69.    REM MAP coordinates               **** THESE ARE BIGGER THAN APRS ***
  70.    DIM LN$(150) ' (no limit in APRS)  **** SO YOU CAN MANIPULATE BIG MAPS
  71.    nn = 2 * MaxNumLABELS
  72.    DIM ML$(nn), MLa(nn), MLo(nn), MLr(nn) 'Map Labels, lengths and coordinates
  73.    nn = 2 * MaxNumMAPS
  74.    DIM MapName$(nn), LATcen(nn), LONcen(nn), MapMax(nn), Comment$(nn)
  75.    RdsOn = -1: Labls = -1: Tags = -1: KP = 1: Changed = 0: MapSize = 256
  76.     
  77. INIT: ON ERROR GOTO ErrorTrap
  78.    ScrnType$ = "EGA": Ycen = 200: Yfactr = 1: YfacTXT = 350 / 350: SCREEN 9
  79.    IF ScrnType$ = "EGA" THEN COLOR 15, 0
  80.    REM ScrnType$ = "CGA": Yfactr=200/400:Ycen = 200*Yfactr: SCREEN 2
  81.   
  82. Display$ = "HELP": GOSUB HELP: GOSUB LoadMap
  83. REM ON ERROR GOTO 0
  84.  
  85. Main: GOSUB DrwMPaCur
  86.       DO
  87. GoAgain: LET a$ = INKEY$
  88.       IF a$ <> "" THEN
  89.         a$ = UCASE$(a$): Key$ = a$
  90.         IF a$ = "S" THEN GOSUB labels
  91.         IF a$ = "L" THEN Labls = NOT Labls
  92.         IF a$ = "T" THEN Tags = NOT Tags
  93.         IF a$ = "F" THEN GOSUB FindPoint
  94.         IF a$ = "G" THEN GOSUB CurToPoint: GOSUB CurDrwMap
  95.         IF a$ = "H" THEN
  96.            IF Display$ <> "HELP" THEN
  97.               GOSUB HELP
  98.            ELSE GOSUB Info
  99.               LOCATE 25, 1: PRINT " H for HELP or SPACE BAR for map..."; : a$ = ""
  100.            END IF
  101.         END IF
  102.         IF a$ = "D" THEN GOSUB MapDIR
  103.         IF a$ = "M" THEN GOSUB ListMAPlist
  104.         IF a$ = "O" THEN GOSUB DrwAndShow
  105.         IF a$ = "N" THEN GOSUB NextLine: GOSUB cursor
  106.         IF a$ = "P" THEN GOSUB Previous: GOSUB cursor
  107.         IF a$ = "Q" THEN GOSUB QUIT
  108.         IF a$ = "R" THEN Z = 2: LNptr = 1
  109.         IF a$ = " " THEN Display$ = "MAP": GOSUB DrwMPaCur
  110.         IF a$ = "+" THEN Z = Z + 1: GOSUB MapPoint ' moves to next map point
  111.         IF a$ = "-" THEN Z = Z - 1: GOSUB MapPoint ' moves backwards
  112.        
  113.         B$ = "": IF LEN(a$) = 2 THEN B$ = RIGHT$(a$, 1): REM process arrow & special keys
  114.         IF B$ = "I" THEN RS = RS * 2: GOSUB CurDrwMap: REM change scale
  115.         IF B$ = "Q" THEN RS = RS / 2: GOSUB CurDrwMap
  116.         IF B$ = CHR$(132) THEN RS = RS * 8: GOSUB CurDrwMap: REM change scale by factor of 4
  117.         IF B$ = "V" THEN RS = RS / 8: GOSUB CurDrwMap
  118.         IF B$ = "G" THEN GOSUB CurDrwMap 'Home key
  119.         IF a$ = "7" THEN CDX = LONo: CDY = LATo: GOSUB DrwMPaCur 'ShiftHOME
  120.         IF B$ = "O" THEN CDX = LONcen: CDY = LATcen: GOSUB DrwMPaCur 'End Key
  121.         IF B$ = "M" THEN CPX = CPX - 4 / (KP * ppdV): GOSUB cursor
  122.         IF B$ = "K" THEN CPX = CPX + 4 / (KP * ppdV): GOSUB cursor
  123.         IF B$ = "H" THEN CPY = CPY + 4 / (KP * ppdV): GOSUB cursor
  124.         IF B$ = "P" THEN CPY = CPY - 4 / (KP * ppdV): GOSUB cursor
  125.         REM Here are the special MapFIx routines
  126.         IF B$ = CHR$(30) THEN GOSUB MakeRoom               'alt-ADD point
  127.         IF B$ = CHR$(50) THEN GOSUB MakePT                 'alt-MOVE point to cursor
  128.         IF B$ = CHR$(32) THEN GOSUB DelPT: GOSUB DrawMap   'alt-DELete point
  129.         IF B$ = CHR$(38) THEN GOSUB AddLabel               'alt-ADD LABEL
  130.         IF B$ = CHR$(46) THEN GOSUB NewCenter              'alt-CENTER
  131.         IF B$ = CHR$(37) THEN GOSUB KillF                  'alt-KILL Feature
  132.         IF B$ = CHR$(19) THEN GOSUB MapRange               'alt-RANGE
  133.         IF B$ = CHR$(20) THEN GOSUB Trim                   'alt-TRIM
  134.         IF B$ = CHR$(49) THEN GOSUB NewFeature             'alt-NEW Feature
  135.         IF B$ = CHR$(61) THEN                              'F3 for smaller Maps
  136.            MapSize = MapSize / 2: IF MapSize < 1 THEN MapSize = 1
  137.            GOSUB ShowMaps
  138.            END IF
  139.         IF B$ = CHR$(62) THEN                              'F4 for larger Maps
  140.            MapSize = MapSize * 2: IF MapSize > 1000 THEN MapSize = 1000
  141.            GOSUB DrwAndShow
  142.         END IF
  143.         IF a$ = CHR$(19) THEN GOSUB SaveMap
  144.            
  145.         IF a$ = "6" THEN CPX = CPX - 20 / (KP * ppdV): GOSUB cursor'SHIFT Cursor by 4
  146.         IF a$ = "4" THEN CPX = CPX + 20 / (KP * ppdV): GOSUB cursor
  147.         IF a$ = "8" THEN CPY = CPY + 20 / (KP * ppdV): GOSUB cursor
  148.         IF a$ = "2" THEN CPY = CPY - 20 / (KP * ppdV): GOSUB cursor
  149.         
  150.       END IF
  151.       
  152.       LOOP
  153.       SYSTEM 'you should never get here
  154.  
  155. QUIT: a$ = "Y"
  156.       IF Changed THEN
  157.          GOSUB BoxLine23
  158.          PRINT "**** MAP HAS BEEN MODIFIED"; Changed; "TIMES BUT NOT SAVED!!!  SAVE NOW? (Y)";
  159.          INPUT a$
  160.       IF UCASE$(a$) <> "N" THEN GOSUB SaveMap
  161.       END IF
  162.       SYSTEM
  163.  
  164. Trim: GOSUB BoxLine23
  165.       CLS : PRINT "TRIM ALL POINTS AND LABELS OUTSIDE OF MAPRANGE"
  166.       PRINT
  167.       PRINT "This command will remove all points and labels that are outside of the white"
  168.       PRINT "map border.  You can change the location of this map border by using"
  169.       PRINT "the CENTER command (alt-C) and by changing the RANGE using alt-R."
  170.       PRINT : PRINT
  171.       PRINT "No map feature will be completely eliminated..."
  172.       PRINT
  173.       PRINT "The first and last point of any FEATURE will be retained, so the"
  174.       PRINT "result will be long single lines for all FEATURES outside the map border."
  175.       PRINT "Use the KILL FEATURE (alt-K) to eliminate those lines and use the MOVE"
  176.       PRINT "command (alt-M) to move any far away points closer to the border."
  177.       PRINT : PRINT
  178.       PRINT "You might consider stopping now and doing a SAVE (ctrl-S) before proceeding."
  179.       PRINT : PRINT
  180.      
  181.       INPUT "Are you ready to proceed? (Y/N) (N)"; a$
  182.       IF UCASE$(a$) <> "Y" THEN GOTO DrawMap
  183.       C = 0: PRINT : PRINT "Processing...";
  184.       REM dx and dy are num pix of center of map
  185.       REM bx and by are borders of map based on MapRng
  186.       FOR Z = 1 TO nmp - 4
  187.          IF x%(Z) = 0 THEN Z = Z + 2
  188.          IF x%(Z) > dx + bx OR y%(Z) > dy + by THEN bad = 1 ELSE bad = 0
  189.          IF x%(Z) < dx - bx OR y%(Z) < dy - by THEN bad = 1
  190.          IF bad AND x%(Z - 1) <> 0 AND x%(Z + 1) <> 0 THEN
  191.             GOSUB DelPT: Z = Z - 1
  192.             C = C + 1: IF INT(C / 10) = C / 10 THEN PRINT ".";
  193.          END IF
  194.       NEXT Z
  195.       PRINT : PRINT "Now removing labels...";
  196.       FOR i = 1 TO nml: REM now eliminate all labels outside
  197.           bad = 0: Xm = MapRng / (60 * Lfac): Ym = MapRng / 60
  198.           IF MLo(i) > LONcen + Xm OR MLa(i) > LATcen + Ym THEN bad = 1
  199.           IF MLo(i) < LONcen - Xm OR MLa(i) < LATcen - Ym THEN bad = 1
  200.           IF bad = 1 THEN
  201.              FOR j = i TO nml
  202.                  ML$(j) = ML$(j + 1): MLa(j) = MLa(j + 1)
  203.                  MLo(j) = MLo(j + 1): MLr(j) = MLr(j + 1)
  204.              NEXT j: nml = nml - 1: PRINT ".";
  205.           END IF
  206.       NEXT i
  207.       GOTO DrawMap
  208.  
  209.  
  210. FindPoint: CurX = INT(.5 + dx + (CUX - 320) / KP)
  211.            CurY = INT(.5 + dy + (CUY - Ycen) / KP)
  212.     FOR j = 0 TO 10: REM go through 10 times looking for closest point.
  213.                      REM first time with no delta, then up to +1 10
  214.         LNctr = 0
  215.         FOR i = 1 TO nmp
  216.             IF x%(i) = 0 THEN LNctr = LNctr + 1
  217.             IF x%(i) > CurX - j AND x%(i) < CurX + j THEN
  218.                IF y%(i) > CurY - j AND y%(i) < CurY + j THEN
  219.                   Z = i: LNptr = LNctr: GOSUB CurToPoint
  220.                   j = 10: i = nmp
  221.                END IF
  222.             END IF
  223.         NEXT i:
  224.     NEXT j
  225.     GOSUB MapPoint: RETURN
  226.                   
  227. NewFeature: LOCATE 24, 1: PRINT SPACE$(27); : GOSUB BoxLine23
  228.             INPUT "Enter reference name for new feature"; a$
  229.             IF a$ = "" THEN RETURN
  230.             LOCATE 25, 1
  231.             FOR i = 0 TO 14
  232.             PRINT RIGHT$(" " + MID$(STR$(i + 1), 2), 2); "   ";
  233.             LINE (16 + i * 40, 335 * YfacTXT)-(40 + i * 40, 349 * YfacTXT), i + 1, BF
  234.             NEXT i
  235.             GOSUB BoxLine23
  236.             INPUT "Select color (4,7,10-Hwys 11-Water 12-Hwy 13-Spcl 14-City)"; B$
  237.             a = VAL(B$): IF a > 15 OR a < 1 THEN RETURN
  238.             x%(nmp) = 0: y%(nmp) = a    'Store feature color 0,c
  239.             LN$(LNi + 1) = LN$(LNi): LNptr = LNi'Bump up present LN$ comment
  240.             LN$(LNi) = a$: LNi = LNi + 1'Store feature name
  241.             nmp = nmp + 1: Z = nmp
  242.             nmp = nmp + 1: x%(nmp) = 0: y%(nmp) = 0'nmp points to ending 0,0
  243.             GOSUB MakePT
  244.             LOCATE 23, 1
  245.             PRINT "NOW MOVE CURSOR AND USE ALT-A TO ADD POINTS TO THIS NEW FEATURE...";
  246.             RETURN
  247.  
  248. NewCenter: LATcen = CPY: LONcen = CPX: Changed = Changed + 1: GOTO CurDrwMap
  249.  
  250. MapRange: GOSUB BoxLine23: INPUT "Enter map range"; a$
  251.           IF VAL(a$) <> 0 THEN MapRng = VAL(a$)
  252.           Changed = Changed + 1: GOTO DrwMPaCur
  253.  
  254. MakeRoom: nmp = nmp + 1: Z = Z + 1
  255.           FOR i = nmp TO Z STEP -1
  256.               x%(i) = x%(i - 1): y%(i) = y%(i - 1)
  257.           NEXT
  258. MakePT: x%(Z) = dx + (CUX - 320) / KP
  259.         y%(Z) = dy + (CUY - Ycen) / KP
  260.         Changed = Changed + 1: GOTO DrawMap
  261.  
  262. CurToPoint:
  263.      CPX = CDX - (x%(Z) - dx) / ppdV
  264.      CPY = CDY - (y%(Z) - dy) / (ppdV * Yfactr)
  265.      GOTO cursor
  266.  
  267. DelPT: GOSUB DelZ
  268.        REM if 1st pt, it stays as 1st pt
  269.  
  270.        IF x%(Z) = 0 THEN Z = Z - 1: REM if end pt, it stays as end          
  271.        IF x%(Z + 1) = 0 AND x%(Z - 1) = 0 THEN 'It is LAST point
  272.           GOSUB Kline: LNptr = LNptr - 1       'So Kill Line
  273.           GOSUB DelZ                           'And Kiil it
  274.           Z = Z - 1: GOSUB DelZ: Z = Z - 1     'Kill 0,color
  275.        END IF                                  'and -1 to end point
  276.        RETURN
  277.  
  278. DelZ: nmp = nmp - 1
  279.       FOR i = Z TO nmp
  280.           x%(i) = x%(i + 1): y%(i) = y%(i + 1)
  281.       NEXT: Changed = Changed + 1: RETURN
  282.  
  283. NextLine: IF Z >= nmp - 1 THEN Z = nmp - 1: BEEP: RETURN
  284.           DO UNTIL x%(Z) = 0: Z = Z + 1: LOOP
  285.           IF Z < nmp - 1 THEN Z = Z + 1: LNptr = LNptr + 1
  286.           GOTO MapPoint
  287. Previous: DO UNTIL Z = 1 OR x%(Z) = 0: Z = Z - 1: LOOP
  288.           IF Z > 3 THEN Z = Z - 1: LNptr = LNptr - 1
  289.           GOTO MapPoint
  290.  
  291. KillF: Bi = Z: Changed = Changed + 1
  292.        DO UNTIL x%(Bi) = 0: Bi = Bi - 1: LOOP: Z = Bi + 1
  293.        REM Stop at Beginning (0) point of the feature to kill
  294.        Ni = Bi + 1' Now scan for next feature
  295.        DO UNTIL x%(Ni) = 0: Ni = Ni + 1: LOOP
  296.        REM now move down rest of array to fill
  297.        DO UNTIL Ni = nmp + 1
  298.            x%(Bi) = x%(Ni): y%(Bi) = y%(Ni)
  299.            Bi = Bi + 1: Ni = Ni + 1
  300.        LOOP
  301.        nmp = nmp - (Ni - Bi): y%(nmp) = 0
  302.        GOSUB Kline
  303.        GOTO DrawMap
  304.      
  305. Kline: FOR i = LNptr TO LNi
  306.            LN$(i) = LN$(i + 1)
  307.            NEXT i
  308.            LNi = LNi - 1
  309.            RETURN
  310.  
  311. MapPoint:
  312.      IF Z < 2 THEN Z = 2: LNptr = 1: BEEP
  313.      IF Z > nmp - 1 THEN Z = Z - 1: BEEP
  314.      IF x%(Z) = 0 THEN
  315.         IF a$ = "-" THEN
  316.              LNptr = LNptr - 1: Z = Z - 1
  317.         ELSE LNptr = LNptr + 1: Z = Z + 1
  318.         END IF
  319.      END IF
  320.      IF LNptr < 0 THEN LNptr = 0
  321.      IF Display$ = "MAP" THEN
  322.           LOCATE 22, 1
  323.           PRINT "Fture#"; LNptr; TAB(12); LEFT$(LN$(LNptr) + "            ", 12);
  324.      END IF
  325. DrwMpPt: IF Display$ <> "MAP" THEN RETURN
  326.      CIRCLE (Xtest, Ytest), 10, 0 'Erase old circle
  327.      Xtest = KP * (x%(Z) - dx) + 320: Ytest = KP * (y%(Z) - dy) + Ycen
  328.      CIRCLE (Xtest, Ytest), 10, 15
  329.      
  330.      LOCATE 23, 1: PRINT "MapPt#"; Z;
  331.      IF Z > 999 THEN PRINT TAB(13); "val:";  ELSE PRINT TAB(12); "vals:";
  332.      PRINT TAB(17); x%(Z); TAB(23); y%(Z)
  333.      RETURN
  334.  
  335. AddLabel: nml = nml + 1
  336.           MLa(nml) = CPY: MLo(nml) = CPX
  337.           GOSUB BoxLine23: INPUT "Enter Label Name"; a$: ML$(nml) = a$
  338.           GOSUB BoxLine23: INPUT "Begin displaying label at what range?"; a$
  339.           a = VAL(a$): IF a <> 0 THEN MLr(nml) = a:  ELSE MLr(nml) = 2048
  340.           Changed = Changed + 1: GOTO labels
  341.  
  342. BoxLine23: LOCATE 23, 1: PRINT SPACE$(80); : LOCATE 23, 1: RETURN
  343.  
  344. ErrorTrap: Fault = ERR: 'Error handling routine
  345.            IF ERR = 57 THEN PRINT "  I/O-error-User-logoff"; : RESUME
  346.            IF ERR = 69 THEN PRINT "  Comm-buffer-overflow"; : RESUME
  347.            IF ERR = 53 THEN PRINT "  file-"; file$; "-not-found": CLOSE : RESUME NEXT
  348.            IF ERR = 62 THEN RESUME NEXT
  349.            IF ERR = 2 THEN PRINT "SYNTAX-error"
  350.            IF ERR = 70 THEN PRINT " WRITE PROTECTED!...": RESUME NEXT
  351.            RESET
  352.            PRINT : PRINT "Error beyond repair. Number = "; ERR;
  353.            INPUT "Hit RETURN to return to DOS"; a$
  354.            SYSTEM
  355.  
  356. MapDIR: CLS : PRINT "MAP FILES DIRECTORY": PRINT
  357.          PRINT "To display MAP files, please enter the path to your xxxxxxx.MAP files."
  358.          PRINT "For example, the default '\APRS\*.MAP' will show all maps in the APRS"
  359.          PRINT "directory.  Similarly '*.map' will search your present QB directory."
  360.          PRINT "For any other path, enter the full file specification.": PRINT
  361.          F$ = "\aprs\*.map"
  362.          PRINT "Enter Filespec for searching the DIRECTORY ("; F$; ")";
  363.          INPUT a$: IF a$ <> "" THEN F$ = a$
  364.          PRINT : PRINT : FILES F$
  365.          RETURN
  366.  
  367.  
  368. LoadMap: 'Maps are drawn to the default EGA resolution of 640 x 400 (350)
  369. Again: LOCATE 23, 2
  370.        INPUT "Which mapfile to look at (ENTER for list, Q to quit)"; a$
  371.        IF UCASE$(a$) = "Q" THEN SYSTEM
  372.        IF a$ = "" THEN GOSUB MapDIR: GOTO Again
  373.        a = INSTR(3, a$, "."): IF a = 0 THEN a$ = a$ + ".map"
  374.        file$ = UCASE$(a$): OPEN file$ FOR INPUT AS #3
  375.        IF Fault = 53 THEN Fault = 0: PRINT : CLOSE #3: GOTO Again
  376.        INPUT #3, LATo: LINE INPUT #3, LatText$
  377.        INPUT #3, LONo: LINE INPUT #3, LonText$
  378.        INPUT #3, ppdV: LINE INPUT #3, VS$'Pixels per degree horiz
  379.        INPUT #3, LATcen: LINE INPUT #3, LATcen$
  380.        INPUT #3, LONcen: LINE INPUT #3, LONcen$
  381.        INPUT #3, MapRng: LINE INPUT #3, MapRng$
  382.        INPUT #3, MinRng: LINE INPUT #3, Mr$
  383.        LINE INPUT #3, TextLine$ ' Line of comments or instrutcitons
  384.        RS = 2 ^ INT(LOG(MapRng) / LOG(2))'Rng is intgr of VERTrng
  385.        REM KP = 256 / RS
  386.        i = 0: LNi = 0:
  387.      
  388.      DO WHILE NOT EOF(3)
  389.         i = i + 1: INPUT #3, x%(i), y: y%(i) = y * Yfactr
  390.         IF x%(i) = 0 AND NOT EOF(3) THEN ' Get line color & store with x=0
  391.            INPUT #3, y%(i): LNi = LNi + 1: LINE INPUT #3, LN$(LNi)' Save line name
  392.            IF y = -1 THEN GOSUB LoadLabels ' All labels listed at end of file
  393.            END IF
  394.         LOOP: nmp = i  'nmp points to 0,-1 that ends all data (but the value
  395.                        'of X% and y% are 0,0 until file is saved.
  396.      LET CDY = LATcen: CDX = LONcen'Center display on ORIGIN
  397.      LET CPX = CDX: CPY = CDY 'Cursor Posn to Center of Display
  398.      LET Z = 2: LNptr = 1: REM start at first point and first line segment
  399.      CLOSE #3: RETURN:     REM first X% value is map color.  2nd val is 1st pt
  400.  
  401.  
  402.  
  403. LoadLabels: K = 0
  404.      DO WHILE NOT EOF(3)
  405.         K = K + 1: INPUT #3, ML$(K), MLa(K), MLo(K), MLr(K)
  406.      LOOP
  407.      IF MLa(K) = 0 OR MLo(K) = 0 THEN nml = K - 1 ELSE nml = K
  408.      RETURN
  409.        
  410. SaveMap: GOSUB BoxLine23: PRINT "Enter file name to save if other than "; file$;
  411.    INPUT a$: IF a$ <> "" THEN file$ = a$
  412.    GOSUB BoxLine23: PRINT "Saving map to file named "; file$; " ..."
  413.    OPEN file$ FOR OUTPUT AS #4
  414.    IF Fault = 70 THEN CLOSE #4: GOTO SaveMap
  415.    PRINT #4, LATo; ","; LatText$
  416.    PRINT #4, LONo; ","; LonText$
  417.    PRINT #4, ppdV; ","; VS$
  418.    PRINT #4, LATcen; ","; LATcen$
  419.    PRINT #4, LONcen; ","; LONcen$
  420.    PRINT #4, MapRng; ","; MapRng$
  421.    PRINT #4, MinRng; ","; Mr$
  422.    PRINT #4, TextLine$
  423.    j = 1
  424.    FOR i = 1 TO nmp
  425.        IF x%(i) <> 0 THEN WRITE #4, x%(i), INT((y%(i) / Yfactr) + .5)
  426.        IF x%(i) = 0 AND i = nmp THEN PRINT #4, " 0,-1"
  427.        IF x%(i) = 0 AND i <> nmp THEN
  428.           PRINT #4, "0,0"
  429.           PRINT #4, y%(i); ","; LN$(j): j = j + 1
  430.        END IF
  431.    NEXT i
  432.    PRINT #4, "0,"; LN$(LNi)
  433.    FOR K = 1 TO nml
  434.        PRINT #4, ML$(K); ","; : WRITE #4, MLa(K), MLo(K), MLr(K)
  435.    NEXT K: CLOSE #4: LOCATE 24, 1:
  436.    Changed = 0
  437.    IF nmp > MaxNumPoints OR nml > MaxNumLABELS THEN
  438.       CLS : LOCATE 9, 29: PRINT "CAUTION!": PRINT : PRINT
  439.       IF nmp > MaxNumPoints THEN
  440.          PRINT "            The number of points is greater than"; MaxNumPoints
  441.       END IF
  442.       IF nml > MaxNumLABELS THEN
  443.          PRINT "            The number of LABELS is greater than"; MaxNumLABELS
  444.       END IF
  445.       LOCATE 18, 12
  446.       PRINT " Therefore this map will not work with APRS (yet) "
  447.       LOCATE 23, 1: INPUT "HIT Enter to continue..."; a$
  448.    END IF: GOTO DrwMPaCur
  449.  
  450. CurDrwMap: CDX = CPX: CDY = CPY: GOTO DrawMap: REM Re-center at CURSOR location
  451.  
  452. DrwMPaCur: CPX = CDX: CPY = CDY: GOSUB DrawMap
  453.            REM After drawing map, Put cursor at center
  454.            RETURN
  455.  
  456. DrawMap: Display$ = "MAP": COLOR 15, 0
  457.    'Draw to range scale RS and center display CDX and CDY
  458.    'Original Map was 40 pix-per-deg Horiz and 20 vert for 200 display
  459.    'Now ppdH and ppdV are variables.  The scaling factor KP is 1 for
  460.    'the original map scale.
  461.    IF RS < MinRng THEN LET RS = MinRng
  462.    IF RS > 8192 THEN RS = 8192
  463.    KP = 100 * 120 / (RS * ppdV)'This is to scale it down from the 120 maps
  464.    Lfac = COS(CDY / 57.296)
  465.    dx = ppdV * (LONo - CDX)
  466.    dy = (LATo - CDY) * ppdV * Yfactr
  467.         
  468.    CLS : LOCATE 1, 2: PRINT "Redrawing Map"
  469.    REM first put ORIGIN and map CENTER on the map
  470.    LINE (320 - KP * dx, Ycen - KP * dy)-(960 - KP * dx, Ycen - KP * dy), 14
  471.    LINE (320 - KP * dx, Ycen - KP * dy)-(320 - KP * dx, 3 * Ycen - KP * dy), 14
  472.    CMX = 320 + KP * (CDX - LONcen) * ppdV
  473.    CMY = Ycen + KP * (CDY - LATcen) * ppdV * Yfactr
  474.    LINE (CMX - 27, CMY)-(CMX + 27, CMY), 14
  475.    LINE (CMX, CMY - 20)-(CMX, CMY + 20), 14
  476.    CIRCLE (CMX, CMY), 10, 14
  477.  
  478.    CIRCLE (320 - KP * dx, Ycen - KP * dy), 12, 14
  479.    FOR i = 0 TO nmp - 1
  480.        x = 320 + KP * (x%(i) - dx): y = Ycen + KP * (y%(i) - dy)
  481.        X1 = 320 + KP * (x%(i + 1) - dx): Y1 = Ycen + KP * (y%(i + 1) - dy)
  482.        IF x%(i + 1) <> 0 THEN
  483.           IF RdsOn OR LineColor <> 12 THEN LINE (x, y)-(X1, Y1), LineColor
  484.        ELSE
  485.           LineColor = y%(i + 1): i = i + 1
  486.           IF Display$ = "SHOW" AND LineColor > 8 THEN LineColor = LineColor - 8
  487.        END IF
  488.    NEXT i
  489.    GOSUB cursor
  490.    GOSUB MapPoint: REM Redraw MapPoint
  491.    IF Display$ = "SHOW" THEN
  492.       GOSUB ShowMaps
  493.    ELSE
  494.       LOCATE 25, 1: PRINT "Use +/- to move MAPpoint.  N/P for Next/Previous Feature.  H for HELP!.";
  495.       LOCATE 1, 61
  496.       PRINT "POINTS"; nmp; "= "; INT((nmp / MaxNumPoints) * 100); "%";
  497.       LOCATE 2, 61
  498.       PRINT "LABELS "; nml; "= "; INT((nml / MaxNumLABELS) * 100); "%";
  499.       LOCATE 3, 61: PRINT "CENTER  "; MID$(STR$(LATcen), 2, 5);
  500.       LOCATE 3, 75: PRINT MID$(STR$(LONcen), 2, 5)
  501.       LOCATE 4, 61: PRINT "SCALE   (ppd)"; ppdV
  502.       LOCATE 5, 69: PRINT "Range"; MapRng
  503.    END IF
  504.  
  505. labels:
  506.    IF Labls THEN
  507.       FOR i = 1 TO nml ' Now plot labels on map
  508.       IF RS <= MLr(i) OR Key$ = "S" THEN
  509.          LET x = 320 + KP * (CDX - MLo(i)) * ppdV
  510.          LET y = Ycen + KP * (CDY - MLa(i)) * ppdV * Yfactr
  511.          IF Tags AND y > 14 * Yfactr AND y < 350 * Yfactr AND x > 8 * (LEN(ML$(i)) + 1) AND x < 632 THEN
  512.             LOCATE y / (14 * Yfactr), (x / 8) - LEN(ML$(i)): PRINT ML$(i);
  513.             END IF
  514.          END IF
  515.       NEXT i
  516.    END IF
  517.    GOSUB ShowMap: RETURN
  518.          
  519. ShowMap: REM this shows the map boarder of the loaded map
  520.     x = 320 + KP * (CDX - LONcen) * ppdV
  521.     y = Ycen + KP * (CDY - LATcen) * ppdV * Yfactr
  522.       by = MapRng * KP * ppdV * Yfactr / 60
  523.       bx = by * 640 / (400 * Yfactr) * Lfac
  524.       C = 15
  525.     LINE (x - bx, y - by)-(x + bx, y + by), C, B
  526.     RETURN
  527.  
  528. cursor: CIRCLE (CUX, CUY), 4, 0
  529.      CUX = 320 + KP * (CDX - CPX) * ppdV
  530.      CUY = Ycen + KP * (CDY - CPY) * ppdV * Yfactr
  531.      CIRCLE (CUX, CUY), 4, 14
  532.      x = INT(CPX): y = INT(CPY): Xm = (CPX - x) * 60: Ym = (CPY - y) * 60
  533.      x$ = RIGHT$(STR$(x), 3) + " "
  534.      LOCATE 1, 2: PRINT "RNG"; RIGHT$("   " + STR$(RS), 4) + "      "
  535.      LOCATE 2, 2: PRINT "LAT "; y; MID$(STR$(Ym) + "   ", 2, 5)
  536.      LOCATE 3, 2: PRINT "LON "; x$; MID$(STR$(Xm) + "   ", 2, 5)
  537.     
  538.      LOCATE 24, 1: PRINT "Cursor coordnts:"; TAB(17);
  539.      PRINT INT(.5 + dx + (CUX - 320) / KP); TAB(23); INT(.5 + dy + (CUY - Ycen) / KP);
  540.      REM LOCATE 24, 55: PRINT "Degrees: ";
  541.      REM PRINT LEFT$(STR$(CPY) + " ", 7); LEFT$(STR$(CPX) + "   ", 7);
  542.      LOCATE 1, 16: PRINT "Decimal";
  543.      LOCATE 2, 15: PRINT LEFT$(STR$(CPY) + " ", 8);
  544.      LOCATE 3, 15: PRINT LEFT$(STR$(CPX) + "   ", 8);
  545.      LINE (0, 0)-(178, 42 * Yfactr), 12, B'Box around it
  546.      LINE (0, 0)-(116, 42 * Yfactr), 12, B'Box around it
  547.      LET a$ = "": LET B$ = "": RETURN
  548.  
  549. HELP: CLS : COLOR 15, 1: LINE (0, 0)-(639, 18 * Yfactr), 14, BF
  550.       LOCATE 1, 20: PRINT " MAPFIX.bas HELP SCREEN Ver 3.06 "
  551.       LOCATE 3, 1
  552.       
  553.       PRINT " The cursor is shown in LAT/LON, map offset and decimal degrees.   The ORIGIN,"
  554.       PRINT " CENTER and BOARDER are shown,  but remember that only the  CENTER and RANGE in"
  555.       PRINT " the MAPLIST.map are actually used in APRS.   Labels are  right justified about"
  556.       PRINT " where a period (.) should be.  CALLS & objects will be left justified."
  557.       PRINT ""
  558.       PRINT " H - HELP screen  D - Directory of maps alt-A Add point    alt-C Center point"
  559.       PRINT " G - Go To Point  F - Find PT @ Cursor  alt-D Delete point alt-R Range"
  560.       PRINT " L - Labels off   S - Show all labels   alt-K Kill Feature                      "
  561.       PRINT " M - MAPLIST.map  O - Other map borders alt-L Add LABEL    alt-T Trim Border pts"
  562.       PRINT " N - Next Feature R - RESET POINTERS    alt-M Move point"
  563.       PRINT " P - Prev Feature Q - QUIT              alt-N New  Feature    ^S SAVE MAP FILE!"
  564.       PRINT
  565.       PRINT " On the MAP screen, use the white arrow keys with NumLock off for best movement"
  566.       PRINT " Space bar        -  Draw map"
  567.       PRINT " Arrow Keys       -  Move cursor. (use Shift with NumLock off to move faster)"
  568.       PRINT " Home (Shift)     -  Home the map to cursor  (Shift-Home the map to ORIGIN)"
  569.       PRINT " PgUp, PgDn       -  Change map scale up/dn by 2 (use CTRL for factor of 8)"
  570.       PRINT " End              -  Redraw map centered on CENTER"
  571.       PRINT " Gray +/- keys    -  Move MapPoint to next point within Feature"
  572.       PRINT
  573.       IF Display$ <> "HELP" THEN
  574.        LOCATE 25, 1
  575.        PRINT " HIT H AGAIN FOR MORE HELP SCREENS, OR SPACE BAR FOR MAP...";
  576.       END IF
  577.       Display$ = "HELP"
  578.       LINE (0, 0)-(634, 348 * Yfactr), 15, B
  579.       RETURN
  580.  
  581.  
  582.  
  583. REM ************* HERE IS THE CODE BROUGHT IN FROM APRS  ***************
  584.  
  585. LdMapLst: MapListLoaded = -1
  586.           F$ = "Maplist.map": OPEN F$ FOR INPUT AS #3
  587.           i = 1: IF Fault = 53 THEN STOP
  588.           INPUT #3, CDY: LINE INPUT #3, a$: DfltY = CDY
  589.           INPUT #3, CDX: LINE INPUT #3, a$: DfltX = CDX
  590.           INPUT #3, BestRng: LINE INPUT #3, a$: DfltR = BestRng
  591.           INPUT #3, GMToffset: LINE INPUT #3, a$
  592.     WHILE a$ <> "* BEGIN *": LINE INPUT #3, a$: WEND ' Skip comment block
  593.           RS = BestRng: REM center display
  594.           RS = 2 ^ INT(LOG(RS) / LOG(2))'Rng is intgr power of 2
  595.           CPX = CDX: CPY = CDY 'Cursor Posn to Center of Display
  596.     WHILE NOT EOF(3) AND i <= UBOUND(MapName$)
  597.           INPUT #3, MapName$(i), LATcen(i), LONcen(i), MapMax(i)
  598.           LINE INPUT #3, Comment$(i)' IGNORE ALL comment fields
  599.           REM now ignore maps that start with a *
  600.           IF LEFT$(MapName$(i), 1) <> "*" THEN NumGood = NumGood + 1
  601.           NumMaps = i: i = i + 1
  602.     WEND: CLOSE #3
  603.     IF NumGood >= MaxNumMAPS - 1 THEN
  604.           CLS : LOCATE 2, 5
  605.           PRINT "WARNING: Too many ACTIVE MAPS (more than"; MaxNumMAPS; ") in MAPLIST.map file for APRS"
  606.           LOCATE 4, 10: PRINT "Use EDITOR to suppress mapnames with an (*) that you don't need."
  607.           PRINT : PRINT : PRINT
  608.           INPUT "HIT RETURN to continue"; a$
  609.     END IF
  610.     RETURN
  611.  
  612. ListMAPlist: IF NOT MapListLoaded THEN GOSUB LdMapLst
  613.    GOSUB ListHeader
  614.    FOR i = 1 TO NumMaps
  615.        IF i / 19 = INT(i / 19) THEN
  616.           LOCATE 25, 1: PRINT "HIT RETURN to continue"; : INPUT a$
  617.           GOSUB ListHeader
  618.        END IF
  619.        PRINT MapName$(i); TAB(14);
  620.        PRINT INT(LATcen(i) * 100) / 100; TAB(21); INT(LONcen(i) * 100) / 100;
  621.        PRINT TAB(29); MapMax(i); TAB(36); LEFT$(Comment$(i), 43)
  622.    NEXT i
  623.    
  624.    LOCATE 25, 1: PRINT "LIST COMPLETE. CONTINUE WITH NEXT MAPFIX COMMAND...";
  625.    RETURN
  626.  
  627. ListHeader: CLS
  628.    PRINT "MAPS in MAPLIST.map (*MAPS are suppressed)     [For now, use EDITOR to modify]"
  629.    PRINT :
  630.    PRINT "MAP NAME      LATcen LONcen  RANGE COmments"
  631.    PRINT "------------  ------ ------- ----- -------------------------------------------"
  632.    RETURN
  633.  
  634. DrwAndShow: IF NOT MapListLoaded THEN GOSUB LdMapLst
  635.             Display$ = "SHOW": GOSUB DrwMPaCur
  636.  
  637. ShowMaps:
  638.     LOCATE 25, 1: PRINT " Drawing all maps >"; MapSize;
  639.     PRINT "mi.  F3 to see smaller, F4 for bigger, SPACE to cancel.";
  640.     LINE (0, 336 * Yfactr)-(639, 349 * Yfactr), 14, B
  641.     FOR i = 1 TO NumMaps
  642.     Lfac = COS(CDY / 57.296)
  643.     Hfac = (640 / 350) * (3 / 4) * Lfac: Sfac = 50 * 200 / RS
  644.     
  645.     x = 320 + Sfac * (CDX - LONcen(i)) * Hfac
  646.     y = Ycen + Sfac * (CDY - LATcen(i)) * Yfactr
  647.       dy = MapMax(i) * Sfac * Yfactr / 60
  648.       dx = dy * 640 / (400 * Yfactr) * Lfac
  649.       C = 15
  650.       IF MapMax(i) > 32 THEN C = 14
  651.       IF MapMax(i) > 64 THEN C = 12
  652.       IF MapMax(i) > 128 THEN C = 11
  653.       IF MapMax(i) > 256 THEN C = 13
  654.           
  655.     IF MapMax(i) > MapSize THEN
  656.        LINE (x - dx, y - dy)-(x + dx, y + dy), C, B
  657.        IF y + dy > 14 * Yfactr AND y + dy < 350 * Yfactr THEN
  658.           IF x + dx > 8 * (LEN(MapName$(i)) + 1) AND x + dx < 632 THEN
  659.              LOCATE (y + dy) / (14 * Yfactr), (x + dx) / 8 - LEN(MapName$(i))
  660.              IF MapMax(i) > RS / 4 THEN PRINT MapName$(i);
  661.           END IF
  662.        END IF
  663.     END IF
  664.     NEXT i: RETURN
  665.         
  666.  
  667. END
  668.  
  669.